perm filename TEXSYS.SAI[TEX,DEK] blob sn#658801 filedate 1982-05-20 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	begin "TEX" comment The TEX processor.
C00008 00003	Error handling procedures: quit,error,backerror,overflow,confusion
C00016 00004	Dynamic memory allocation: links, memsize, varsize, mem, memreal
C00020 00005	Partial field macros: field,ufield,link,info,setfield...setinfo
C00025 00006	Memory allocation procedures: getavail, freeavail, getnode, freenode
C00030 00007	Memory, continued: dslist,delrclink,delgluelink,checkmem,initmem
C00040 00008	Getting the whole thing started properly
C00049 ENDMK
C⊗;
begin "TEX" comment The TEX processor.

This processor is in five parts:

1. The present module contains routines for memory management,
	initialization, and external control (getting things
	started and stopped gracefully).
2. The TEXSYN module, compiled separately, contains routines 
	for scanning the input, including such things as the
	expansion of user-defined macros.
3. The TEXSEM module, compiled separately, contains routines
	for building the data structures corresponding to the
	user's source text.
4. The TEXOUT module, compiled separately, contains routines
	for outputting the data structures to a peripheral device.
	(Substitution of a different TEXOUT module will direct
	the output to a different device.) The current TEXOUT module
	is called TEXPRS and produces "press" files for the Xerox
	Dover printers, and other devices.
5. The TEXEXT module, compiled separately, contains extensions
	that some users may decide to write in SAIL. In the
	initial implementation, only a dummy version of TEXEXT
	has been written, but calls to this module have been
	placed at critical points in the control structure.

There is an independently running program TEXPRE that does the preprocessing
necessary to compute the initial values of TEX's hash table, equivalents table,
and hyphenation tables, and that stores them on file TEXINI.TBL. The TEXPRE
program should be consulted for details about the initial contents of these
tables.

Finally, there is also a TEXHDR file that contains all the declarations of
variables used by more than one module.

It is wise to look at the first page of TEXHDR before reading the
following code, since TEXHDR introduces a few abbreviations that are
used throughout the TEX programs.

Historical notes: A prototype version of TEX was designed and coded by M. F. Plass
and F. M. Liang during the summer of 1977. The prototype included macro definitions
and elementary semantic manipulations on nodes and glue, but it did not have
paragraph justification, page building, mathematical formulas, alignment routines,
error recovery, or the present semantic nest. It used character lists instead of
token lists. Based on this experience, a complete version of TEX was designed and
coded by D. E. Knuth in late 1977 and early 1978, becoming operational in
March, 1978. The present code is the original March 1978 version with about 500
"small" changes, all of which are listed in file DEBUG.LOG;

require 1200 system_pdl;
require "TEXHDR.SAI" source_file;
require "TEXSYN.REL" load_module;
require "TEXSEM.REL" load_module;
require ifc DVIOUT thenc "TEXDVI.REL" elsec "TEXPRS.REL" endc load_module;
require "TEXEXT.REL" load_module;

comment To compile TEX with the BAIL debugger, make sure that DEBUGONLY
is defined to be ⊂⊃ in TEXHDR, then do "com texsyn(27b,)" and
"com texsem(27b,)" and "com texprs(27b,)" and "com texext(27b,)" and
"try texpre(5000s)" and finally "try texsys".
To compile TEX without BAIL, make sure that DEBUGONLY is defined to be
⊂comment⊃ in TEXHDR, then do "com texsyn,texsem,texprs,texext" and
"ex texpre(5000s)" and "ex texsys";
comment Error handling procedures: quit,error,backerror,overflow,confusion;

label end_of_TEX,final_end;
internal procedure quit # closes output files and terminates TEX;
begin integer c;
DEBUGONLY print(nextline,"Quitting. Do you want a chance to see the memory?");
DEBUGONLY c←inchrw;
DEBUGONLY if c="y" then bail;
go to end_of_TEX;
end;

internal boolean pausing_on_errors # should TEX wait after error messages?;
internal boolean not_nonstop # should TEX wait for other reasons?;
integer errcnt # the number of errors that TEX didn't wait after;
internal boolean deletions_allowed # is it safe for error routine to call getnext?;

internal procedure error(string s) # prints an error message;
begin comment String s explains the type of error. This is displayed to the
user and then the current source code position is indicated;
print(nextline,"! ",s,".");
dumpcontext # prints indication of where the scanner is now;
if pausing_on_errors then
  loop	begin integer c;
	print("↑") # prompt the user;
	clrbuf # if user was typing ahead, clear the system buffer;
	c←inchrw # wait for user to type a character;
	setprint(null,"F"); print(c&null); setprint(null,"B") # echo on ERRORS.TMP;
	ifc TENEX and (not TOPS20) thenc
	if c='37 then return # Tenex end-of-line character;
	elsec
	if c='15 then begin c←inchrw # ignore the line-feed; return end;
	endc
	if c>'140 then c←c-'40 # change lower case to upper case;
	if c="C" then return;
	if c='12 or c="S" then begin pausing_on_errors←false; return end;
	if c='14 or c="F" then begin pausing_on_errors←not_nonstop←false; return end;
	ifc not(TENEX or TOPS20) thenc
	if curfile and (c="E" or c="T") then
		begin comment abort and enter the system editor;
		setprint(null,"N") # close the errors file;
		edfile(curfile,curfline,curfpage);
		end;
	endc
	ifc EMACS thenc # this code due to DRF;
	if curfile and (c="E" or c="T") then
		begin string s; integer i;
		setprint(null,"N") # close the errors file;
		s←"ED "&'15&'33&"X Fi"&'33&curfile&'15
			# ED cr esc X FIND FILE esc curfile cr;
		s←s&'33&"X↑R Goto B"&'15
			# esc X ↑R GOTO BEGINNING cr;
		s←s&'25&cvs(curfpage-1)&'33&"X↑R Char"&'15&'14
			# cntl-u <page no> esc X ↑R CHARACTER SEARCH cr cntl-L;
		s←s&'33&"1"&'33&"X↑R Rev"&'33&"C"&'15&'14
			# esc 1 esc X ↑R REVERSE CHARACTER SEARCH cr cntl-L;
		s←s&'25&cvs(curfline-1)&'33&"X↑R Down R"&'15
			# cntl-u <line no> esc X ↑R DOWN REAL LINE cr;
		for i←1 thru length(s) do sti('101,s[i for 1]) # magic ;
		goto final_end;
		end;
	endc

	if c="I" then
		begin pushinput;
		print(nextline,"*"); inbuf←inchwl # wait for user to type a line;
		setprint(null,"F");
		print(inbuf&nextline); setprint(null,"B") # echo it;
		curbuf←inbuf; state←midline; filename←null;
		return;
		end;
	if c≥"1" and c≤"9" and deletions_allowed then
		begin integer i; i←c-"0";
		while i>0 do
			begin getnext # recursive call shouldn't happen;
			i←i-1;
			end;
		dumpcontext # print new scanner status;
		continue;
		end;
	DEBUGONLY if c="B" then
	DEBUGONLY	begin bail;
	DEBUGONLY	return;
	DEBUGONLY	end;
	if c="X" then
		begin print(nextline,"Type x again to exit:");
		clrbuf; c←inchrw;
		if c="x" or c="X" then go to end_of_TEX;
		end;
	print(nextline,"Type c or C to continue, s or S to scroll all error messages,");
	if deletions_allowed then print(nextline,
		"	1 or ... or 9 to ignore the next 1 to 9 tokens of input,");
	print(nextline,"	i or I to insert something,");
	ifc (not(TENEX or TOPS20)) or EMACS thenc
		if curfile then print(" e or E to edit,"); endc
	print(" x or X to quit.",nextline);
	end
else begin
	errcnt←errcnt+1;
	if errcnt≥100 then
		begin print(nextline,"(That makes 100 errors, I'm tired of this.)");
		go to end_of_TEX;
		end;
	end;
end;

internal procedure backerror(string s) # error preceded by backinput;
begin backinput;
error(s);
end;

internal procedure errorstop(string s) # prints message and dies;
begin pausing_on_errors←false; 
error(s);
quit;
end;

internal procedure reportoverflow(string s; integer n)
	# for fatal errors when a TEX table is undersized;
errorstop("TEX capacity exceeded, sorry ["&s&"="&cvs(n)&"]");

internaldef overflow(s)=⊂reportoverflow("s",s)⊃ # specifies inadequate table size;
internal procedure memoverflow; overflow(memsize);

internal procedure confusion # TEX consistency check failure;
errorstop("This can't happen");

internal procedure mustquit # user input is really wild;
errorstop("All mixed up, can't continue");
comment Dynamic memory allocation: links, memsize, varsize, mem, memreal;

comment TEX does nearly all of its own memory allocation, so that it can
readily be transported into environments that do not have automatic
facilities for strings, garbage collection, etc. The dynamic storage
requirements of TEX are handled by providing a large integer array "mem" 
in which consecutive blocks of words are used as nodes by the TEX routines.
Pointer variables are indices into this array. To use mem[p] as a real
variable instead of as an integer, we write "memreal(p)".

The mem array is divided once and for all into two regions that are allocated
separately. The first varsize locations are used for storing variable-length
records consisting of two or more words. This region is maintained using an
algorithm similar to the one described in exercise 2.5-19 of ACP. However,
no size field appears in the allocated nodes: the program is responsible for
knowing the relevant size when the node is freed. Also, the sign in the first
word of each node is used as a boundary tag by the allocation routines, so
ALL DATA STRUCTURES MUST BE DESIGNED TO ENSURE THAT THE FIRST WORD OF
TWO-OR-MORE-WORD NODES IS NONNEGATIVE. The remaining region of mem is allocated
in single words using a conventional AVAIL stack.
;
internaldef links = 14 # number of bits per pointer;
internaldef memsize=8000 # size of dynamic list memory, must be ≤ 2↑links;
internaldef varsize=2500 # size of variable node memory, must be << memsize;
comment TEXHDR contains the true values of these volatile parameters;

comment saf integer array mem[0:memsize] # dynamic list memory;
comment mem has been made internal to TEXSEM, for the sake of more efficient code;
internaldef memreal(p)=⊂memory[location(mem[p]),real]⊃ # mem[p] as type real;
internaldef avail=⊂mem[memsize]⊃ # head of available space list for one-word nodes;

MSTAT internal integer dynused,varused # how much memory is in use;
MSTAT internal integer maxdynused,maxvarused # how much memory was in use;
comment Partial field macros: field,ufield,link,info,setfield...setinfo;

comment The following macros are for accessing and modifying partial fields
of packed words. If f is a field name, then fs denotes its size in bits
and fd denotes its displacement from the right of the word. These sizes and
displacements are defined at compile time--e.g.,"links" for size of link fields.
In the following definitions, x denotes the word being modified and y denotes
a new value to be inserted into the specified field (it must not be too
large for the field). The definitions look inefficient, but they take
advantage of the fact that SAIL does a lot of local optimization;


internaldef fs(f) = ⊂f⊃&"s" # field size of f, in bits;
internaldef fd(f) = ⊂f⊃&"d" # field displacement of f, in bits;

internaldef field(f,x) = ⊂ifc fd(f)=0 thenc ((x) land (2↑fs(f)-1))
	elsec ifc fs(f)+fd(f)≥bitsperwd thenc ((x) lsh -fd(f))
	elsec (((x) lsh -fd(f)) land (2↑fs(f)-1)) endc endc⊃ # field f of x;

internaldef setfield(f,x,y) = ⊂ifc fd(f)=0 thenc x←(x land(-2↑fs(f)))+(y)
	elsec ifc fs(f)+fd(f)≥bitsperwd thenc 
		x←((x lsh(bitsperwd-fd(f)))+(y))rot fd(f)
	elsec x←(((x rot -fd(f))land(-2↑fs(f)))+(y))rot fd(f) endc endc⊃
		# sets field f of x equal to y, 0 ≤ y < 2↑fs(f);

comment Sometimes an unshifted field is desired. For this purpose, we use
ufield instead of field, and deal with values times 2↑fd;

internaldef ufield(f,x) = ⊂((x) land((1 lsh(fs(f)+fd(f)))-2↑fd(f)))⊃
		# unshifted field f of x;
internaldef setufield(f,x,y) = ⊂x←(x land lnot((1 lsh(fs(f)+fd(f)))-2↑fd(f)))+(y)⊃
		# field f of x set to unshifted value y;

comment The special case of a pointer field at the right of a word is
most common, so there are special conventions for it. When p is a pointer,
we write link(p) for the pointer field of mem[p] and info(p) for the
(shifted) remaining fields of the word;

internaldef linkd = 0 # displacement of link field;
internaldef link(p) = ⊂field(link,mem[p])⊃ # link field of mem[p];
internaldef setlink(p,y) = ⊂setfield(link,mem[p],y)⊃ # sets link(p)←y;
internaldef infod = links, infos = bitsperwd-infod # definition of info field;
internaldef info(p) = ⊂field(info,mem[p])⊃ # info field of mem[p];
internaldef setinfo(p,y) = ⊂setfield(info,mem[p],y)⊃ # sets info(p)←y;

DEBUGONLY integer procedure lk(integer x);
DEBUGONLY return(x land(2↑links-1)) # link field of packed word;
DEBUGONLY integer procedure fo(integer x);
DEBUGONLY return(x lsh -infod) # info field of packed word;
DEBUGONLY string procedure oct(integer x);
DEBUGONLY return(cvos(x));
comment Memory allocation procedures: getavail, freeavail, getnode, freenode;

comment	getavail(p) makes p point to a new one-word node,
	freeavail(p) returns it to storage.
	p←getnode(s) makes p point to a new s-word node and clears mem[p] to zero,
	freenode(p,s) will return this node to storage.
;
internaldef getavail(p) = ⊂begin if(p←avail)then avail←mem[avail]
	else memoverflow: MSTAT dynused←dynused+1:
	MSTAT if dynused>maxdynused then maxdynused←dynused end⊃ # p ← new node;
internaldef freeavail(p) = ⊂begin mem[p]←avail: avail←p:
	MSTAT dynused←dynused-1: end⊃ # node p now available;

comment The available space list for variable-size nodes is a nonempty,
doubly-linked circular list, pointed to by the roving pointer "rover". 
The second word of each entry contains the size (which is always ≥2), while
the first word contains the llink and rlink and a minus sign;

integer rover # pointer into double-avail list;
define nodesize(p) = ⊂mem[p+1]⊃;
define llinks = links, llinkd = infod # definition of llink field;

internal integer procedure getnode(integer size) # variable-size node allocation;
begin comment returns a pointer to a new node of the specified size,
which must be 2 or more. All words of the new node are set to zero;
integer p,q,s,t,u;
label ovfl, found;
comment The following tricky code does
	llink(rlink(p))←llink(p), rlink(llink(p))←rlink(p);
define removenode(p)=
	⊂begin if p=rover then
		begin rover←link(p);
		if p=rover then go to ovfl # list musn't become empty;
		end;
	u←((p lsh llinkd) + p) xor mem[p] # bits to change;
	t←field(llink,mem[p]) # llink(p);
	mem[t]←field(link,u) xor mem[t];
	t←link(p) # rlink(p);
	mem[t]←ufield(llink,u) xor mem[t];
	end⊃;
p←rover;
do	begin q←p+nodesize(p) # q points past the end of node(p);
	while mem[q]<0 do
		begin comment merge with the next node, if it is free too;
		removenode(q); q←q+nodesize(q);
		end;
	if (s←q-p) ≥ size+2 then
		begin q←q-size # allocate from top end;
		nodesize(p)←q-p # remaining free area size;
		rover ← p # let rover rove around;
		go to found;
		end;
	if s = size then
		begin removenode(p) # exact fit, now t = rlink(p);
		rover ← t # let rover rove;
		q ← p; go to found;
		end;
	nodesize(p)←s # reset the node size in case it grew;
	p←link(p);
	end until p=rover # repeat until whole list traversed;
ovfl: overflow(varsize) # no large enough space was found;
found: for p ← q thru q+size-1 do mem[p]←0 # clear out the node found;
MSTAT varused←varused+size;
MSTAT if varused>maxvarused then maxvarused←varused;
return(q) # deliver the goods;
end;

internal procedure freenode(integer p,size) # variable-size node liberation;
begin comment The node of length "size" starting at mem[p] is made available
to the variable-node storage pool, by inserting it into the double-avail
list just before where rover now points. We must have size ≥ 2;
integer q;
q←field(llink,mem[rover]) # llink(rover);
setlink(q,p); setfield(llink,mem[rover],p);
mem[p]←(q lsh llinkd)+rover+(1 lsh(bitsperwd-1)) # now p is linked into the circle;
MSTAT varused←varused-size;
nodesize(p)←size;
end;
comment Memory, continued: dslist,delrclink,delgluelink,checkmem,initmem;

internal procedure dslist(integer p) # makes list of 1-word nodes available;
begin comment The linked list of single-word nodes pointed to by p is freed;
integer q;
while p do
	begin q←link(p); freeavail(p); p←q;
	end;
end;

internaldef refct1 = 1 lsh infod # 1 in the information (reference count) field;

internal simp procedure delrclink(integer p) # remove ptr to list with ref ct;
begin comment info(p) is a reference count that is to be decreased by 1.
If the result is negative, the linked list of single-word nodes pointed to by p
is freed;
if(mem[p]←mem[p]-refct1)<0 then dslist(p);
end;

internal simp procedure delgluelink(integer p) # remove pointer to glue node;
begin comment info(p) is a reference count that is to be decreased by 1.
If the result is negative, node(p) (which has "gluespecsize" words) is freed;
if(mem[p]←mem[p]-refct1)<0 then freenode(p,gluespecsize);
comment In this case it's OK to let the first word of the node go negative;
end;

DEBUGONLY integer array free[0:memsize-1];
DEBUGONLY internal procedure checkmem(boolean printlocs) # checks links in mem;
DEBUGONLY begin comment This procedure checks the format of the available space
DEBUGONLY lists and (if printlocs is true) prints those locations of mem that were
DEBUGONLY free the last time this procedure was called but reserved now.
DEBUGONLY All nodes should be returned to the avail lists when TEX is done with
DEBUGONLY them, and checkmem can be used to check if this has been done correctly;
DEBUGONLY integer p,i;
DEBUGONLY integer kount;
DEBUGONLY label checksign;
DEBUGONLY p←avail;
DEBUGONLY kount←0;
DEBUGONLY while p do
DEBUGONLY 	begin if (mem[p]≥memsize) or (free[p] land 1) or
DEBUGONLY		(mem[p]≠0 and mem[p]≤varsize) then
DEBUGONLY 		begin print(nextline,"avail list clobbered at ",p);
DEBUGONLY		bail;
DEBUGONLY		done;
DEBUGONLY 		end;
DEBUGONLY 	free[p]←free[p] lor 1;
DEBUGONLY	kount←kount+1;
DEBUGONLY 	p←mem[p];
DEBUGONLY 	end;
DEBUGONLY print(nextline,kount," one-word cells available.");
DEBUGONLY p←rover;
DEBUGONLY do	begin
DEBUGONLY 	if p≥varsize or p≤0 or mem[p]≥0 or p+nodesize(p)>varsize or
DEBUGONLY 	nodesize(p)<2 or field(llink,mem[link(p)])≠p then
DEBUGONLY 		begin print(nextline,"double-avail list clobbered at ",p);
DEBUGONLY		bail;
DEBUGONLY		done;
DEBUGONLY 		end;
DEBUGONLY 	for i←p thru p+nodesize(p)-1 do
DEBUGONLY 		begin if free[i] land 1 then
DEBUGONLY 			begin print(nextline,"doubly free location at ",i);
DEBUGONLY 			bail;
DEBUGONLY			go to checksign;
DEBUGONLY 			end;
DEBUGONLY 		free[i]←free[i] lor 1;
DEBUGONLY 		end;
DEBUGONLY 	p←link(p);
DEBUGONLY 	end until p=rover;
DEBUGONLY checksign: i←0;
DEBUGONLY	while i< varsize do
DEBUGONLY	begin if mem[i]<0 then
DEBUGONLY		begin print(nextline,"node ",i,"starts negative");
DEBUGONLY		bail;
DEBUGONLY		end;
DEBUGONLY	while i<varsize and (free[i] land 1)=0 do i←i+1;
DEBUGONLY	while i<varsize and (free[i] land 1)≠0 do i←i+1;
DEBUGONLY	end;
DEBUGONLY if printlocs then print(nextline,"New busy locs: ");
DEBUGONLY for i←0 thru memsize-1 do
DEBUGONLY 	begin if free[i] land 3 = 2 and printlocs then print(i," ");
DEBUGONLY 	free[i]←free[i] lsh 1;
DEBUGONLY 	end;
DEBUGONLY end;

DEBUGONLY procedure searchmem(integer p) # finds pointers to p;
DEBUGONLY begin integer i;
DEBUGONLY for i←0 thru memsize-1 do
DEBUGONLY 	begin if link(i)=p then print(nextline,"link(",i,")");
DEBUGONLY 	if value(i)=p then print(nextline,"value(",i,")");
DEBUGONLY 	end;
DEBUGONLY for i←0 thru hashsize+127 do if field(link,eqtb[i])=p then
DEBUGONLY	print(nextline,"link in eqtb[",i,"]");
DEBUGONLY end;

comment Some areas of mem are dedicated to fixed usage. For example, the
list heads "pagehead" and "pagecontrib" of the page builder are assigned
to fixed memory locations. (Since mem[pagecontrib] will never be
negative, we define pagecontrib=varsize, then the getfree procedure will
never try to combine the one-word memory with a variable-size free node.)
The special glue used in \hfill and \vfill is kept in a fixed place, as
are the heads of alignrecord lists. Only locations mem[firstmem] thru
mem[varsize-1] are actually allocatable for variable-size memory, 
and mem[secondmem] thru mem[memsize-1] for one-word memory.
;
internaldef fillglue=0 # location of glue specification 0pt plus 10↑10 pt;
internaldef filglue=gluespecsize # loc of glue spec 0pt plus 10↑5 pt;
internaldef filglueneg=filglue+gluespecsize # loc of glue spec 0pt plus -10↑5;
internaldef lowerfillglue=filglueneg+gluespecsize # loc of glue specification
		0pt plus 10↑5pt minus 10↑5 pt;
internaldef zeroglue=lowerfillglue+gluespecsize # loc of glue specification 0pt;
internaldef separatorspec=zeroglue+gluespecsize # loc of botsep, topsep specs;
internaldef fontglue=separatorspec+2*insspecsize # location of glue for variable spaces;
internaldef firstmem=fontglue+nfonts*gluespecsize # location of 
		first usable mem word, must be >0;
internaldef waitinghead=varsize # head of list of inserts too big for current page;
internaldef contribhead=waitinghead+1 # head of contribution vlist for current page;
internaldef pagehead=pagecontrib+1 # head of vlist for current page;
internaldef temphead=pagehead+1 # temporary head of a miscellaneous list;
internaldef holdhead=temphead+1 # temporary head of another miscellaneous list;
internaldef alignhead=holdhead+1 # alignhead+j is head of jth alignrecordlist;
internaldef inserts=alignhead+alignsize # head of insert list returned by packager;
internaldef active=inserts+1 # head of active list in justifier;
internaldef inactive=active+1 # head of inactive list in justifier;
internaldef secondmem=inactive+1 # first usable mem word in 1-word area;

internal procedure initmem # initializes the memory system;
begin integer i;
for i←secondmem thru memsize-1 do mem[i+1]←i;
mem[secondmem]←0 # now the avail stack is initialized;

mem[firstmem]←(firstmem lsh llinkd)+firstmem+(1 lsh(bitsperwd-1));
nodesize(firstmem)←varsize-firstmem # one node in the circle;
rover←firstmem # rover points to it, now the double-avail list is initialized;

for i←0 thru firstmem-1 do mem[i]←0;
for i←varsize thru secondmem-1 do mem[i]←0;
end;
comment Getting the whole thing started properly;

preload_with true; safe boolean array notalreadyinitialized[0:0];

IFSUAI
external integer rpgsw # tells if we were started by snail;
ENDSUAI

string errname,tblname,inputname; integer i;
errname ← ifc MIT thenc "ERRORS TMP" elsec
	ifc TENEX thenc "ERRORS.TMP;T" elsec "ERRORS.TMP" endc;
tblname ← ifc MIT thenc "TEX;TEXINI TBL" elsec "TEXINI.TBL" endc;

comment The declarations have now ended, TEX starts here after being loaded;
if notalreadyinitialized[0] then
	begin integer chan;
	notalreadyinitialized[0]←false;
	initmem # initialize the mem array, this should be done first;
	gluestretch(fillglue)←10000000000.0 # initialize the fillglue;
	gluestretch(lowerfillglue)←glueshrink(lowerfillglue)←
		gluestretch(filglue)←100000.0;
	gluestretch(filglueneg)← -gluestretch(filglue);
	mem[zeroglue]←mem[lowerfillglue]←mem[fillglue]←mem[filglue]
		←mem[filglueneg]←1000000 lsh infod # "infinite" reference count;
	mem[separatorspec]←mem[separatorspec+insspecsize]←0 #
		no topsep,botsep specified yet;
	initsftable(3.0,3.0,3.0,2.0,1.5,1.25) # initialize the spacefactor table;

	open(chan←getchan,"DSK",'10,2,0,0,0,eof);
	lookup(chan,tblname,eof);
	if eof or wordin(chan)≠secondmem or wordin(chan)≠memsize or
		wordin(chan)≠hashsize or wordin(chan)≠hprime or
		wordin(chan)≠eqtbsize or
		wordin(chan)≠excepsize or wordin(chan)≠sufsize or
		wordin(chan)≠prefsize or wordin(chan)≠btabsize or
		wordin(chan)≠pagememsize or wordin(chan)≠fmemsize or
		wordin(chan)≠locs then
		begin
			print(tblname," is clobbered!");
			go to final_end;
		comment If this error happens, execute TEXPRE to rewrite the file;
		end;
	arryin(chan,mem[secondmem],memsize+1-secondmem);
	arryin(chan,hash[locs],hashsize+1-locs);
	arryin(chan,hhead[0],hprime);
	arryin(chan,eqtb[0],eqtbsize);
	arryin(chan,exceptable[0],excepsize);
	arryin(chan,excephyph[1],excepsize-1);
	arryin(chan,suffix[0],sufsize);
	arryin(chan,prefix[0],prefsize);
	arryin(chan,btable[2],btabsize);
	arryin(chan,pagemem[0],pagememsize);
	arryin(chan,delimtable[0],128);
	arryin(chan,fmem[0],fmemsize);
	arryin(chan,fcksum[0],nfonts);
	arryin(chan,fsize[0],nfonts);
	arryin(chan,dsize[0],nfonts);
	arryin(chan,fpfi[0,1],nfonts*5);
	arryin(chan,fpfb[0],nfonts);
	arryin(chan,wdbase[0],nfonts);
	arryin(chan,htbase[0],nfonts);
	arryin(chan,dpbase[0],nfonts);
	arryin(chan,icbase[0],nfonts);
	arryin(chan,lgbase[0],nfonts);
	arryin(chan,krbase[0],nfonts);
	arryin(chan,extbase[0],nfonts);
	arryin(chan,parbase[0],nfonts);
	arryin(chan,fontinfo[0],128*nfonts);
	fmemptr←wordin(chan);
	hashpar←wordin(chan);
	hashsend←wordin(chan);
	release(chan);
	arrclr(savedbox);

 	errcnt←0;
	pausing_on_errors←true; not_nonstop←true; deletions_allowed←true;

	outstr("TEX's tables have been initialized. "&
		"Please SAVE the core image.");
	ifc SUAI thenc ptostr(0,"SAVE tex") endc # this is what the user probably wants to do next;
	ifc TENEX thenc if inchwl then endc;
	ifc not PARC thenc go to final_end endc;
	end;

IFTOPS20
start_code
    setz  1,0;
    jsys  '500;	haltf;
    end;
inputname←intty # gets the users command line that started up TEX;
while length(inputname)>0 and inputname[1 for 1] neq " " do i←lop(inputname);
while length(inputname)>0 and inputname[1 for 1]=" " do i←lop(inputname);
if length(inputname)>0 then begin
	integer errpos # points past the directory part of the name;
	# user gave a file name in command line;
	if inputname[∞ for 1]="/" then
		begin inputname←inputname[1 to ∞-1];
		pausing_on_errors←false # this job is to be run in batch mode;
		not_nonstop←false # so it shouldn't stop for any reason;
		end;
	i←1; errpos←1;
	while i<=length(inputname) and inputname[i for 1] neq "." do 
		if inputname[i for 1]="<" then
			while i<=length(inputname) and 
				inputname[i for 1] neq ">" do errpos←1+(i←i+1)
		else if inputname[i for 1]=":" then errpos←(i←i+1)
		else i←i+1;
	errname←inputname[errpos to i-1]&".ERR";
	inputname←"\input "&inputname&'15 # we will stuff this into tty buffer;
	end;
ENDTOPS20
IFSUAI
if rpgsw then begin string s; integer err,c;
	string outname, inname, flags;
	outname←inname←flags←"";
	s←tmpin("TEX",err);
	if not err then begin
		while s and (s≠"←") do outname←outname&lop(s);
		c←lop(s);
		while s and (s≠"(") and (s≠13) do inname←inname&lop(s);
		if s="(" then c←lop(s);
		while s and (s≠13) do flags←flags&lop(s);
		if flags[inf to inf]=")" then flags←flags[1 to inf-1];
		end;
	inputname←flags&"\input "&inname&'15 # will be stuffed into tty buffer;
	end;
ENDSUAI

setformat(0,4) # controls format of cvf in diagnostic routine "dumpnodelist";
setprint(errname,"B") # printing goes to file as well as terminal;
ifc PARC thenc print("PARC TEX 6.6 of July 13, 1981",nextline); endc
ifc MIT thenc print("MIT TEX m.n of Octuary 20, 2001",nextline); endc
initext # initialize the extensions if any;
initsave # initialize the save-restore mechanism;
MSTAT dynused←varused←maxdynused←maxvarused←0;
initin # initialize the input system;
initout # initialize the output system;
IFC TOPS20 or SUAI THENC
if length(inputname)>0 then begin
	curbuf←inbuf←inputname;
	setprint(null,"F"); print(inbuf&'12); setprint(null,"B");
	escapechar←"\";
	chartype(escapechar)←escape;
	end;
ENDC
maincontrol # transfer power to the chief executive;

end_of_TEX: closeout # close output files of TEXOUT;
setprint(errname,"N") # close print output file;
finishext # do any closing actions desired by extensions;
final_end:
ifc EMACS thenc
	start_code haltf; jrst .-1; comment no `End of SAIL execution';
	end;
endc
end "TEX"